home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / ENTRPRIS / CALLBACK / CLBK_SVR.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-11-23  |  5.1 KB  |  155 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    Caption         =   "CallBack Clock Server"
  4.    ClientHeight    =   1140
  5.    ClientLeft      =   4350
  6.    ClientTop       =   3870
  7.    ClientWidth     =   3465
  8.    ClipControls    =   0   'False
  9.    MaxButton       =   0   'False
  10.    PaletteMode     =   1  'UseZOrder
  11.    ScaleHeight     =   1140
  12.    ScaleWidth      =   3465
  13.    Begin VB.Timer Timer1 
  14.       Enabled         =   0   'False
  15.       Interval        =   5000
  16.       Left            =   2985
  17.       Top             =   60
  18.    End
  19.    Begin VB.Label lblInterval 
  20.       AutoSize        =   -1  'True
  21.       Caption         =   "00"
  22.       BeginProperty Font 
  23.          Name            =   "MS Sans Serif"
  24.          Size            =   9.75
  25.          Charset         =   0
  26.          Weight          =   700
  27.          Underline       =   0   'False
  28.          Italic          =   0   'False
  29.          Strikethrough   =   0   'False
  30.       EndProperty
  31.       Height          =   240
  32.       Left            =   2025
  33.       TabIndex        =   4
  34.       Top             =   645
  35.       Width           =   255
  36.    End
  37.    Begin VB.Label Label1 
  38.       AutoSize        =   -1  'True
  39.       Caption         =   "(Secs.)"
  40.       BeginProperty Font 
  41.          Name            =   "MS Sans Serif"
  42.          Size            =   9.75
  43.          Charset         =   0
  44.          Weight          =   700
  45.          Underline       =   0   'False
  46.          Italic          =   0   'False
  47.          Strikethrough   =   0   'False
  48.       EndProperty
  49.       Height          =   240
  50.       Index           =   2
  51.       Left            =   2595
  52.       TabIndex        =   3
  53.       Top             =   630
  54.       Width           =   750
  55.    End
  56.    Begin VB.Label Label1 
  57.       AutoSize        =   -1  'True
  58.       Caption         =   "Update Interval:"
  59.       BeginProperty Font 
  60.          Name            =   "MS Sans Serif"
  61.          Size            =   9.75
  62.          Charset         =   0
  63.          Weight          =   700
  64.          Underline       =   0   'False
  65.          Italic          =   0   'False
  66.          Strikethrough   =   0   'False
  67.       EndProperty
  68.       Height          =   240
  69.       Index           =   1
  70.       Left            =   150
  71.       TabIndex        =   2
  72.       Top             =   630
  73.       Width           =   1665
  74.    End
  75.    Begin VB.Label Label1 
  76.       AutoSize        =   -1  'True
  77.       Caption         =   "Current Time:"
  78.       BeginProperty Font 
  79.          Name            =   "MS Sans Serif"
  80.          Size            =   9.75
  81.          Charset         =   0
  82.          Weight          =   700
  83.          Underline       =   0   'False
  84.          Italic          =   0   'False
  85.          Strikethrough   =   0   'False
  86.       EndProperty
  87.       Height          =   240
  88.       Index           =   0
  89.       Left            =   150
  90.       TabIndex        =   1
  91.       Top             =   270
  92.       Width           =   1395
  93.    End
  94.    Begin VB.Label lblTime 
  95.       AutoSize        =   -1  'True
  96.       Caption         =   "00:00:00"
  97.       BeginProperty Font 
  98.          Name            =   "MS Sans Serif"
  99.          Size            =   9.75
  100.          Charset         =   0
  101.          Weight          =   700
  102.          Underline       =   0   'False
  103.          Italic          =   0   'False
  104.          Strikethrough   =   0   'False
  105.       EndProperty
  106.       Height          =   240
  107.       Left            =   2025
  108.       TabIndex        =   0
  109.       Top             =   285
  110.       Width           =   855
  111.    End
  112. Attribute VB_Name = "frmMain"
  113. Attribute VB_GlobalNameSpace = False
  114. Attribute VB_Creatable = False
  115. Attribute VB_TemplateDerived = False
  116. Attribute VB_PredeclaredId = True
  117. Attribute VB_Exposed = False
  118. Option Explicit
  119. Dim sCurTime As String
  120. Private Sub lblInterval_Click()
  121.   lblInterval.Caption = Format$(Timer1.Interval / 1000)
  122. End Sub
  123. Private Sub Timer1_Timer()
  124.   Dim iCounter As Integer
  125.   ' Used by OLE Collision Handler
  126.   Dim nCurErrorCount As Integer
  127.   Const MAX_ERROR_COUNT = 10
  128.   On Error GoTo CallbackError
  129.       If gbConnected Then
  130.         sCurTime = Time
  131.         lblTime.Caption = sCurTime
  132. 100   gObjRef.TellTime (sCurTime)
  133. 110 End If
  134. Exit Sub
  135. CallbackError:
  136.   'When using asynchronous callbacks between two OLE objects, this error checking code is
  137.   'necessary to deal with a chance of a collision.  This collision can occur when a client and
  138.   'server attempt to call each at the same time. This error handler forces the server to wait for a
  139.   'random period of time and retry the failed operation.  During this wait time, the client should
  140.   'complete it's call to the server allowing the server to succeed when it retrys the call to the client.
  141.   'The same error handling code also needs to be implemented in the client object.
  142.   If Erl = 100 And Err = &H80010001 Then
  143.     If nCurErrorCount >= MAX_ERROR_COUNT Then
  144.       MsgBox "Unable to release server reference.  Retry later.", vbExclamation, "Remote Server Disconnect Error"
  145.       Resume EndOfError
  146.     Else
  147.       For iCounter = 1 To 2000 * Rnd()
  148.         DoEvents
  149.       Next iCounter
  150.       Resume
  151.     End If
  152.   End If
  153. EndOfError:
  154. End Sub
  155.